home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / checkout.tcl.z / checkout.tcl
Encoding:
Text File  |  1999-04-16  |  10.4 KB  |  341 lines
  1. #
  2. # Tcl Library for tkCVS
  3. #
  4.  
  5. #
  6. # $Id: checkout.tcl,v 1.16 1995/11/06 05:02:01 davide Exp $
  7. #
  8. # Set up a check out dialog.
  9. #
  10.  
  11. proc checkout_setup {} {
  12.   global checkout_mcode
  13.   global checkout_version
  14.  
  15.   # This variable is a list containing all of the directories and
  16.   # subdirectories that are expanded on the listbox.
  17.  
  18.   global displayed_list
  19.  
  20.   toplevel .checkout
  21.   frame .checkout.menubar -relief raised -border 2
  22.   frame .checkout.down -relief groove -border 2
  23.   frame .checkout.up
  24.   frame .checkout.up.left -relief raised
  25.   frame .checkout.up.right -relief raised
  26.  
  27.   pack .checkout.menubar .checkout.up -side top -fill x
  28.   pack .checkout.down -side bottom -fill x
  29.   pack .checkout.up.left -side left -fill both
  30.   pack .checkout.up.right -side left -fill both -expand 1
  31.  
  32.   label .checkout.lmcode -text "Module Code" -anchor w
  33.   label .checkout.lvers -text "Tag A" -anchor w
  34.   label .checkout.lvers2 -text "Tag B" -anchor w
  35.   entry .checkout.tmcode -relief sunken -textvariable checkout_mcode
  36.   entry .checkout.tvers -relief sunken -textvariable checkout_version
  37.   entry .checkout.tvers2 -relief sunken -textvariable checkout_version2
  38.  
  39.   # bind_motifentry .checkout.tmcode
  40.   # bind_motifentry .checkout.tvers
  41.   # bind_motifentry .checkout.tvers2
  42.  
  43.   pack .checkout.lmcode .checkout.lvers .checkout.lvers2 -in .checkout.up.left \
  44.     -side top -fill x -pady 3
  45.   pack .checkout.tmcode .checkout.tvers .checkout.tvers2 -in .checkout.up.right \
  46.     -side top -fill both -expand 1 -pady 3
  47.  
  48.   #
  49.   # Create the Menu bar
  50.   #
  51.  
  52.   menubutton .checkout.menubar.reports -text Reports -underline 0 \
  53.     -menu .checkout.menubar.reports.m
  54.   menubutton .checkout.menubar.search -text Search -underline 0 \
  55.     -menu .checkout.menubar.search.m
  56.   menubutton .checkout.menubar.patch -text Patch -underline 0 \
  57.     -menu .checkout.menubar.patch.m
  58.   menubutton .checkout.menubar.tag -text Tag -underline 0 \
  59.     -menu .checkout.menubar.tag.m
  60.   menubutton .checkout.menubar.help -text Help -underline 0 \
  61.     -menu .checkout.menubar.help.m
  62.   pack .checkout.menubar.reports .checkout.menubar.search \
  63.     .checkout.menubar.patch .checkout.menubar.tag \
  64.     -side left
  65.   pack .checkout.menubar.help \
  66.     -side right
  67.  
  68.   #
  69.   # Create menus
  70.   #
  71.  
  72.   menu .checkout.menubar.reports.m
  73.   .checkout.menubar.reports.m add command -label "Module Tree ..." \
  74.     -underline 7 \
  75.     -command {modlist_by_code $checkout_mcode 0 $checkout_version}
  76.   .checkout.menubar.reports.m add command -label "Modules Sorted by Name ..." \
  77.     -underline 18 \
  78.     -command {modlist_by_name 0 $checkout_version}
  79.   .checkout.menubar.reports.m add command -label "Version Tree ..." \
  80.     -command {modlist_by_code $checkout_mcode 1 $checkout_version}
  81.   .checkout.menubar.reports.m add command -label "Version Listing by Name ..." \
  82.     -command {modlist_by_name 1 $checkout_version}
  83.  
  84.   menu .checkout.menubar.search.m
  85.   .checkout.menubar.search.m add command \
  86.     -label "Search Repository by Code ..." \
  87.     -underline 21 \
  88.     -command code_search
  89.   .checkout.menubar.search.m add command \
  90.     -label "Search Repository by Name ..." \
  91.     -underline 21 \
  92.     -command name_search
  93.   .checkout.menubar.search.m add command \
  94.     -label "Search Repository by Keyword ..." \
  95.     -underline 21 \
  96.     -command keyword_search
  97.  
  98.   menu .checkout.menubar.patch.m
  99.   .checkout.menubar.patch.m add command -label "Make Patch File ..." \
  100.     -command {
  101.       cvs_patch $checkout_mcode $checkout_version $checkout_version2
  102.       wm withdraw .checkout
  103.     }
  104.   .checkout.menubar.patch.m add command -label "View Patch Summary ..." \
  105.     -command {
  106.       cvs_patch_summary $checkout_mcode $checkout_version $checkout_version2
  107.     }
  108.  
  109.   menu .checkout.menubar.tag.m
  110.   .checkout.menubar.tag.m add command -label "Tag Module" \
  111.     -command {
  112.       cvs_rtag $checkout_mcode "no" $checkout_version $checkout_version2
  113.     }
  114.   .checkout.menubar.tag.m add command -label "Branch Tag Module" \
  115.     -command {
  116.       cvs_rtag $checkout_mcode "yes" $checkout_version $checkout_version2
  117.     }
  118.  
  119.   menu .checkout.menubar.help.m
  120.   .checkout.menubar.help.m add command -label "Overview ..." \
  121.     -command module_browser
  122.   .checkout.menubar.help.m add separator
  123.   .checkout.menubar.help.m add command -label "Checking out Modules ..." \
  124.     -command checking_out_modules
  125.   .checkout.menubar.help.m add command -label "Exporting ..." \
  126.     -command exporting
  127.   .checkout.menubar.help.m add command -label "Tagging and Branching ..." \
  128.     -command tagging_and_branching
  129.   .checkout.menubar.help.m add separator
  130.   .checkout.menubar.help.m add command -label "Menu ..." \
  131.     -command module_browser_menu
  132.   .checkout.menubar.help.m add command -label "Buttons ..." \
  133.     -command module_browser_buttons
  134.   .checkout.menubar.help.m add separator
  135.   .checkout.menubar.help.m add command -label "File Browser ..." \
  136.     -command file_browser
  137.   .checkout.menubar.help.m add command -label "Log Browser ..." \
  138.     -command log_browser
  139.   .checkout.menubar.help.m add separator
  140.   .checkout.menubar.help.m add command -label "CVS modules File ..." \
  141.     -command cvs_modules_file
  142.  
  143.   #
  144.   # Create buttons
  145.   #
  146.  
  147.   button .checkout.co -text "Check Out" \
  148.     -command {
  149.       cvs_checkout $checkout_mcode $checkout_version
  150.       # wm withdraw .checkout
  151.     }
  152.   button .checkout.export -text "Export" \
  153.     -command {
  154.       cvs_export $checkout_mcode $checkout_version
  155.       # wm withdraw .checkout
  156.     }
  157.   button .checkout.browse -text "File Browse" \
  158.     -command {browse_files $checkout_mcode}
  159.  
  160.   # create a summary of the files which have changed between versions. -sj
  161.   button .checkout.ps -text "Patch Summary" \
  162.     -command {
  163.        cvs_patch_summary $checkout_mcode \
  164.                          $checkout_version \
  165.                          $checkout_version2
  166.     }
  167.  
  168.   button .checkout.quit -text "Quit" \
  169.     -command {wm withdraw .checkout}
  170.  
  171.   pack .checkout.co .checkout.export .checkout.ps \
  172.        .checkout.browse .checkout.quit \
  173.     -in .checkout.down -side left \
  174.     -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1
  175.  
  176.   # Create a scroll bar and three list boxes.
  177.   scrollbar .checkout.scroll -relief sunken \
  178.     -command {checkout_scroll}
  179.   # Set up a selection rule so that only one item can be selected
  180.   # at a time.
  181.   listbox .checkout.namelist \
  182.     -yscroll {.checkout.scroll set} -relief sunken \
  183.     -width 40 -height 20 -setgrid yes -selectmode single
  184.   listbox .checkout.infolist \
  185.     -yscroll {.checkout.scroll set} -relief sunken \
  186.     -width 10 -height 20 -setgrid yes -selectmode single
  187.   listbox .checkout.codelist \
  188.     -yscroll {.checkout.scroll set} -relief sunken \
  189.     -width 20 -height 20 -setgrid yes -selectmode single
  190.  
  191.   # Set up key bindings for the lists so that they all select as
  192.   # if the code list was pointed to.
  193.   bind .checkout.codelist <Double-Button-1> \
  194.     {checkout_act_on_code %y}
  195.   bind .checkout.namelist <Double-Button-1> \
  196.     {checkout_act_on_code %y}
  197.   bind .checkout.infolist <Double-Button-1> \
  198.     {checkout_act_on_code %y}
  199.   bind .checkout.codelist <1> {checkout_select_code %y}
  200.   bind .checkout.namelist <1> {checkout_select_code %y}
  201.   bind .checkout.infolist <1> {checkout_select_code %y}
  202.   bind .checkout.codelist <Button-2> { nop }
  203.   bind .checkout.codelist <Any-B2-Motion> { nop }
  204.   bind .checkout.namelist <Button-2> { nop }
  205.   bind .checkout.namelist <Any-B2-Motion> { nop }
  206.   bind .checkout.infolist <Button-2> { nop }
  207.   bind .checkout.infolist <Any-B2-Motion> { nop }
  208.  
  209.   # Pack the scroll bar and the 3 lists side by side.
  210.   pack .checkout.scroll -side right -fill y -padx 2 -pady 2
  211.   pack .checkout.namelist .checkout.infolist .checkout.codelist \
  212.     -side left -fill both -expand 1
  213.  
  214.   # Window manager stuff.
  215.   wm withdraw .checkout
  216.   wm title .checkout "Module Browser"
  217.   wm minsize .checkout 1 1
  218.  
  219.   set displayed_list {}
  220.   checkout_fill_listbox
  221. }
  222.  
  223. proc checkout_scroll {args} {
  224.  
  225. # To support scrolling 3 listboxes simultaneously
  226.  
  227.   eval ".checkout.namelist yview $args"
  228.   eval ".checkout.infolist yview $args"
  229.   eval ".checkout.codelist yview $args"
  230. }
  231.  
  232. proc checkout_run {} {
  233.   wm deiconify .checkout
  234. }
  235.  
  236. proc checkout_fill_listbox {} {
  237. #
  238. # Do this to update the display of the listbox.
  239. #
  240.   global displayed_list
  241.   global dtitle
  242.  
  243.   .checkout.namelist delete 0 end
  244.   .checkout.infolist delete 0 end
  245.   .checkout.codelist delete 0 end
  246.  
  247.   if {! [info exists dtitle]} {
  248.     return
  249.   }
  250.  
  251.   foreach dname [array names dtitle] {
  252.     if {[file dirname $dname] == "."} {
  253.       .checkout.namelist insert end $dtitle($dname)
  254.       .checkout.infolist insert end "Directory"
  255.       .checkout.codelist insert end $dname
  256.       if {[lsearch $displayed_list $dname] != -1} {
  257.         checkout_fill_dir $dname
  258.       }
  259.     }
  260.   }
  261. }
  262.  
  263. proc checkout_fill_dir {dname} {
  264.   global mtitle
  265.   global dtitle
  266.   global dcontents
  267.   global dsubmenus
  268.   global displayed_list
  269.  
  270.   # Display all of the modules in this subdir.
  271.  
  272.   if [info exists dcontents($dname)] {
  273.     foreach mname $dcontents($dname) {
  274.       .checkout.namelist insert end $mtitle($mname)
  275.       .checkout.infolist insert end "Module"
  276.       .checkout.codelist insert end $mname
  277.     }
  278.   }
  279.  
  280.   # Recurse through each subdir, only displaying sublevels of those
  281.   # that are marked for display.
  282.  
  283.   if [info exists dsubmenus($dname)] {
  284.     foreach subdir $dsubmenus($dname) {
  285.       .checkout.namelist insert end $dtitle($subdir)
  286.       .checkout.infolist insert end "Directory"
  287.       .checkout.codelist insert end $subdir
  288.       if {[lsearch $displayed_list $subdir] != -1} {
  289.         checkout_fill_dir $subdir
  290.       }
  291.     }
  292.   }
  293. }
  294.  
  295. proc checkout_select_code {yposition} {
  296. #
  297. # Do this when a code is clicked on.
  298. #
  299.   global checkout_ypos
  300.   global checkout_mcode
  301.  
  302.   set checkout_ypos $yposition
  303.  
  304.   # This does the actual selection
  305.   .checkout.codelist select set \
  306.     [.checkout.codelist nearest $yposition]
  307.   set code [selection get]
  308.  
  309.   # This will update the "Module Name" entry box.
  310.   set checkout_mcode [lindex $code 0]
  311.  
  312.   return $code
  313. }
  314.  
  315. proc checkout_act_on_code {yposition} {
  316. #
  317. # Do this when a code is double-clicked on.
  318. #
  319.   global checkout_mcode
  320.   global displayed_list
  321.  
  322.   # Do the selection bit.
  323.   set code [checkout_select_code $yposition]
  324.  
  325.   # If the module is displayed, remove it from the display.  If it is
  326.   # not displayed, add it to the display.
  327.   set pos [lsearch $displayed_list $checkout_mcode]
  328.   if {$pos == -1} {
  329.     lappend displayed_list $checkout_mcode
  330.   } else {
  331.     set displayed_list [lreplace $displayed_list $pos $pos]
  332.   }
  333.  
  334.   # Redraw the listbox.
  335.   checkout_fill_listbox
  336.  
  337.   # Do the selection bit again so that the item remains selected after the
  338.   # redraw.
  339.   set code [checkout_select_code $yposition]
  340. }
  341.